home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 008a / perl40_2.zip / DOARG.C < prev    next >
C/C++ Source or Header  |  1991-11-28  |  42KB  |  1,813 lines
  1. /* $RCSfile: doarg.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:31:58 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    doarg.c,v $
  9.  * Revision 4.0.1.5  91/11/11  16:31:58  lwall
  10.  * patch19: added little-endian pack/unpack options
  11.  *
  12.  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  13.  * patch11: /$foo/o optimizer could access deallocated data
  14.  * patch11: minimum match length calculation in regexp is now cumulative
  15.  * patch11: added some support for 64-bit integers
  16.  * patch11: prepared for ctype implementations that don't define isascii()
  17.  * patch11: sprintf() now supports any length of s field
  18.  * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
  19.  * patch11: defined(&$foo) and undef(&$foo) didn't work
  20.  *
  21.  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  22.  * patch10: pack(hh,1) dumped core
  23.  *
  24.  * Revision 4.0.1.2  91/06/07  10:42:17  lwall
  25.  * patch4: new copyright notice
  26.  * patch4: // wouldn't use previous pattern if it started with a null character
  27.  * patch4: //o and s///o now optimize themselves fully at runtime
  28.  * patch4: added global modifier for pattern matches
  29.  * patch4: undef @array disabled "@array" interpolation
  30.  * patch4: chop("") was returning "\0" rather than ""
  31.  * patch4: vector logical operations &, | and ^ sometimes returned null string
  32.  * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
  33.  *
  34.  * Revision 4.0.1.1  91/04/11  17:40:14  lwall
  35.  * patch1: fixed undefined environ problem
  36.  * patch1: fixed debugger coredump on subroutines
  37.  *
  38.  * Revision 4.0  91/03/20  01:06:42  lwall
  39.  * 4.0 baseline.
  40.  *
  41.  */
  42.  
  43.  
  44. #include "EXTERN.h"
  45. #include "perl.h"
  46.  
  47.  
  48. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  49. #include <signal.h>
  50. #endif
  51.  
  52.  
  53. extern unsigned char fold[];
  54.  
  55.  
  56. #ifdef BUGGY_MSC
  57.  #pragma function(memcmp)
  58. #endif /* BUGGY_MSC */
  59.  
  60.  
  61. int
  62. do_subst(str,arg,sp)
  63. STR *str;
  64. ARG *arg;
  65. int sp;
  66. {
  67.     register SPAT *spat;
  68.     SPAT *rspat;
  69.     register STR *dstr;
  70.     register char *s = str_get(str);
  71.     char *strend = s + str->str_cur;
  72.     register char *m;
  73.     char *c;
  74.     register char *d;
  75.     int clen;
  76.     int iters = 0;
  77.     int maxiters = (strend - s) + 10;
  78.     register int i;
  79.     bool once;
  80.     char *orig;
  81.     int safebase;
  82.  
  83.  
  84.     rspat = spat = arg[2].arg_ptr.arg_spat;
  85.     if (!spat || !s)
  86.     fatal("panic: do_subst");
  87.     else if (spat->spat_runtime) {
  88.     nointrp = "|)";
  89.     (void)eval(spat->spat_runtime,G_SCALAR,sp);
  90.     m = str_get(dstr = stack->ary_array[sp+1]);
  91.     nointrp = "";
  92.     if (spat->spat_regexp) {
  93.         regfree(spat->spat_regexp);
  94.         spat->spat_regexp = Null(REGEXP*);    /* required if regcomp pukes */
  95.     }
  96.     spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  97.         spat->spat_flags & SPAT_FOLD);
  98.     if (spat->spat_flags & SPAT_KEEP) {
  99.         scanconst(spat, m, dstr->str_cur);
  100.         arg_free(spat->spat_runtime);    /* it won't change, so */
  101.         spat->spat_runtime = Nullarg;    /* no point compiling again */
  102.         hoistmust(spat);
  103.             if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  104.                 curcmd->c_flags &= ~CF_OPTIMIZE;
  105.                 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
  106.             }
  107.     }
  108.     }
  109. #ifdef DEBUGGING
  110.     if (debug & 8) {
  111.     deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  112.     }
  113. #endif
  114.     safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
  115.       !sawampersand);
  116.     if (!spat->spat_regexp->prelen && lastspat)
  117.     spat = lastspat;
  118.     orig = m = s;
  119.     if (hint) {
  120.     if (hint < s || hint > strend)
  121.         fatal("panic: hint in do_match");
  122.     s = hint;
  123.     hint = Nullch;
  124.     if (spat->spat_regexp->regback >= 0) {
  125.         s -= spat->spat_regexp->regback;
  126.         if (s < m)
  127.         s = m;
  128.     }
  129.     else
  130.         s = m;
  131.     }
  132.     else if (spat->spat_short) {
  133.     if (spat->spat_flags & SPAT_SCANFIRST) {
  134.         if (str->str_pok & SP_STUDIED) {
  135.         if (screamfirst[spat->spat_short->str_rare] < 0)
  136.             goto nope;
  137.         else if (!(s = screaminstr(str,spat->spat_short)))
  138.             goto nope;
  139.         }
  140. #ifndef lint
  141.         else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
  142.           spat->spat_short)))
  143.         goto nope;
  144. #endif
  145.         if (s && spat->spat_regexp->regback >= 0) {
  146.         ++spat->spat_short->str_u.str_useful;
  147.         s -= spat->spat_regexp->regback;
  148.         if (s < m)
  149.             s = m;
  150.         }
  151.         else
  152.         s = m;
  153.     }
  154.     else if (!multiline && (*spat->spat_short->str_ptr != *s ||
  155.       bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
  156.         goto nope;
  157.     if (--spat->spat_short->str_u.str_useful < 0) {
  158.         str_free(spat->spat_short);
  159.         spat->spat_short = Nullstr;    /* opt is being useless */
  160.     }
  161.     }
  162.     once = !(rspat->spat_flags & SPAT_GLOBAL);
  163.     if (rspat->spat_flags & SPAT_CONST) {    /* known replacement string? */
  164.     if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
  165.         dstr = rspat->spat_repl[1].arg_ptr.arg_str;
  166.     else {                    /* constant over loop, anyway */
  167.         (void)eval(rspat->spat_repl,G_SCALAR,sp);
  168.         dstr = stack->ary_array[sp+1];
  169.     }
  170.     c = str_get(dstr);
  171.     clen = dstr->str_cur;
  172.     if (clen <= spat->spat_regexp->minlen) {
  173.                     /* can do inplace substitution */
  174.         if (regexec(spat->spat_regexp, s, strend, orig, 0,
  175.           str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
  176.         if (spat->spat_regexp->subbase) /* oops, no we can't */
  177.             goto long_way;
  178.         d = s;
  179.         lastspat = spat;
  180.         str->str_pok = SP_VALID;    /* disable possible screamer */
  181.         if (once) {
  182.             m = spat->spat_regexp->startp[0];
  183.             d = spat->spat_regexp->endp[0];
  184.             s = orig;
  185.             if (m - s > strend - d) {    /* faster to shorten from end */
  186.             if (clen) {
  187.                 (void)bcopy(c, m, clen);
  188.                 m += clen;
  189.             }
  190.             i = strend - d;
  191.             if (i > 0) {
  192.                 (void)bcopy(d, m, i);
  193.                 m += i;
  194.             }
  195.             *m = '\0';
  196.             str->str_cur = m - s;
  197.             STABSET(str);
  198.             str_numset(arg->arg_ptr.arg_str, 1.0);
  199.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  200.             return sp;
  201.             }
  202.             /*SUPPRESS 560*/
  203.             else if (i = m - s) {    /* faster from front */
  204.             d -= clen;
  205.             m = d;
  206.             str_chop(str,d-i);
  207.             s += i;
  208.             while (i--)
  209.                 *--d = *--s;
  210.             if (clen)
  211.                 (void)bcopy(c, m, clen);
  212.             STABSET(str);
  213.             str_numset(arg->arg_ptr.arg_str, 1.0);
  214.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  215.             return sp;
  216.             }
  217.             else if (clen) {
  218.             d -= clen;
  219.             str_chop(str,d);
  220.             (void)bcopy(c,d,clen);
  221.             STABSET(str);
  222.             str_numset(arg->arg_ptr.arg_str, 1.0);
  223.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  224.             return sp;
  225.             }
  226.             else {
  227.             str_chop(str,d);
  228.             STABSET(str);
  229.             str_numset(arg->arg_ptr.arg_str, 1.0);
  230.             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  231.             return sp;
  232.             }
  233.             /* NOTREACHED */
  234.         }
  235.         do {
  236.             if (iters++ > maxiters)
  237.             fatal("Substitution loop");
  238.             m = spat->spat_regexp->startp[0];
  239.             /*SUPPRESS 560*/
  240.             if (i = m - s) {
  241.             if (s != d)
  242.                 (void)bcopy(s,d,i);
  243.             d += i;
  244.             }
  245.             if (clen) {
  246.             (void)bcopy(c,d,clen);
  247.             d += clen;
  248.             }
  249.             s = spat->spat_regexp->endp[0];
  250.         } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
  251.             Nullstr, TRUE));    /* (don't match same null twice) */
  252.         if (s != d) {
  253.             i = strend - s;
  254.             str->str_cur = d - str->str_ptr + i;
  255.             (void)bcopy(s,d,i+1);        /* include the Null */
  256.         }
  257.         STABSET(str);
  258.         str_numset(arg->arg_ptr.arg_str, (double)iters);
  259.         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  260.         return sp;
  261.         }
  262.         str_numset(arg->arg_ptr.arg_str, 0.0);
  263.         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  264.         return sp;
  265.     }
  266.     }
  267.     else
  268.     c = Nullch;
  269.     if (regexec(spat->spat_regexp, s, strend, orig, 0,
  270.       str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
  271.     long_way:
  272.     dstr = Str_new(25,str_len(str));
  273.     str_nset(dstr,m,s-m);
  274.     if (spat->spat_regexp->subbase)
  275.         curspat = spat;
  276.     lastspat = spat;
  277.     do {
  278.         if (iters++ > maxiters)
  279.         fatal("Substitution loop");
  280.         if (spat->spat_regexp->subbase
  281.           && spat->spat_regexp->subbase != orig) {
  282.         m = s;
  283.         s = orig;
  284.         orig = spat->spat_regexp->subbase;
  285.         s = orig + (m - s);
  286.         strend = s + (strend - m);
  287.         }
  288.         m = spat->spat_regexp->startp[0];
  289.         str_ncat(dstr,s,m-s);
  290.         s = spat->spat_regexp->endp[0];
  291.         if (c) {
  292.         if (clen)
  293.             str_ncat(dstr,c,clen);
  294.         }
  295.         else {
  296.         char *mysubbase = spat->spat_regexp->subbase;
  297.  
  298.  
  299.         spat->spat_regexp->subbase = Nullch;    /* so recursion works */
  300.         (void)eval(rspat->spat_repl,G_SCALAR,sp);
  301.         str_scat(dstr,stack->ary_array[sp+1]);
  302.         if (spat->spat_regexp->subbase)
  303.             Safefree(spat->spat_regexp->subbase);
  304.         spat->spat_regexp->subbase = mysubbase;
  305.         }
  306.         if (once)
  307.         break;
  308.     } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
  309.         safebase));
  310.     str_ncat(dstr,s,strend - s);
  311.     str_replace(str,dstr);
  312.     STABSET(str);
  313.     str_numset(arg->arg_ptr.arg_str, (double)iters);
  314.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  315.     return sp;
  316.     }
  317.     str_numset(arg->arg_ptr.arg_str, 0.0);
  318.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  319.     return sp;
  320.  
  321.  
  322. nope:
  323.     ++spat->spat_short->str_u.str_useful;
  324.     str_numset(arg->arg_ptr.arg_str, 0.0);
  325.     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
  326.     return sp;
  327. }
  328. #ifdef BUGGY_MSC
  329.  #pragma intrinsic(memcmp)
  330. #endif /* BUGGY_MSC */
  331.  
  332.  
  333. int
  334. do_trans(str,arg)
  335. STR *str;
  336. ARG *arg;
  337. {
  338.     register short *tbl;
  339.     register char *s;
  340.     register int matches = 0;
  341.     register int ch;
  342.     register char *send;
  343.     register char *d;
  344.     register int squash = arg[2].arg_len & 1;
  345.  
  346.  
  347.     tbl = (short*) arg[2].arg_ptr.arg_cval;
  348.     s = str_get(str);
  349.     send = s + str->str_cur;
  350.     if (!tbl || !s)
  351.     fatal("panic: do_trans");
  352. #ifdef DEBUGGING
  353.     if (debug & 8) {
  354.     deb("2.TBL\n");
  355.     }
  356. #endif
  357.     if (!arg[2].arg_len) {
  358.     while (s < send) {
  359.         if ((ch = tbl[*s & 0377]) >= 0) {
  360.         matches++;
  361.         *s = ch;
  362.         }
  363.         s++;
  364.     }
  365.     }
  366.     else {
  367.     d = s;
  368.     while (s < send) {
  369.         if ((ch = tbl[*s & 0377]) >= 0) {
  370.         *d = ch;
  371.         if (matches++ && squash) {
  372.             if (d[-1] == *d)
  373.             matches--;
  374.             else
  375.             d++;
  376.         }
  377.         else
  378.             d++;
  379.         }
  380.         else if (ch == -1)        /* -1 is unmapped character */
  381.         *d++ = *s;        /* -2 is delete character */
  382.         s++;
  383.     }
  384.     matches += send - d;    /* account for disappeared chars */
  385.     *d = '\0';
  386.     str->str_cur = d - str->str_ptr;
  387.     }
  388.     STABSET(str);
  389.     return matches;
  390. }
  391.  
  392.  
  393. void
  394. do_join(str,arglast)
  395. register STR *str;
  396. int *arglast;
  397. {
  398.     register STR **st = stack->ary_array;
  399.     register int sp = arglast[1];
  400.     register int items = arglast[2] - sp;
  401.     register char *delim = str_get(st[sp]);
  402.     int delimlen = st[sp]->str_cur;
  403.  
  404.  
  405.     st += ++sp;
  406.     if (items-- > 0)
  407.     str_sset(str, *st++);
  408.     else
  409.     str_set(str,"");
  410.     if (delimlen) {
  411.     for (; items > 0; items--,st++) {
  412.         str_ncat(str,delim,delimlen);
  413.         str_scat(str,*st);
  414.     }
  415.     }
  416.     else {
  417.     for (; items > 0; items--,st++)
  418.         str_scat(str,*st);
  419.     }
  420.     STABSET(str);
  421. }
  422.  
  423.  
  424. void
  425. do_pack(str,arglast)
  426. register STR *str;
  427. int *arglast;
  428. {
  429.     register STR **st = stack->ary_array;
  430.     register int sp = arglast[1];
  431.     register int items;
  432.     register char *pat = str_get(st[sp]);
  433.     register char *patend = pat + st[sp]->str_cur;
  434.     register int len;
  435.     int datumtype;
  436.     STR *fromstr;
  437.     /*SUPPRESS 442*/
  438.     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
  439.     static char *space10 = "          ";
  440.  
  441.  
  442.     /* These must not be in registers: */
  443.     char achar;
  444.     short ashort;
  445.     int aint;
  446.     unsigned int auint;
  447.     long along;
  448.     unsigned long aulong;
  449. #ifdef QUAD
  450.     quad aquad;
  451.     unsigned quad auquad;
  452. #endif
  453.     char *aptr;
  454.     float afloat;
  455.     double adouble;
  456.  
  457.  
  458.     items = arglast[2] - sp;
  459.     st += ++sp;
  460.     str_nset(str,"",0);
  461.     while (pat < patend) {
  462. #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
  463.     datumtype = *pat++;
  464.     if (*pat == '*') {
  465.         len = index("@Xxu",datumtype) ? 0 : items;
  466.         pat++;
  467.     }
  468.     else if (isDIGIT(*pat)) {
  469.         len = *pat++ - '0';
  470.         while (isDIGIT(*pat))
  471.         len = (len * 10) + (*pat++ - '0');
  472.     }
  473.     else
  474.         len = 1;
  475.     switch(datumtype) {
  476.     default:
  477.         break;
  478.     case '%':
  479.         fatal("% may only be used in unpack");
  480.     case '@':
  481.         len -= str->str_cur;
  482.         if (len > 0)
  483.         goto grow;
  484.         len = -len;
  485.         if (len > 0)
  486.         goto shrink;
  487.         break;
  488.     case 'X':
  489.       shrink:
  490.         if (str->str_cur < len)
  491.         fatal("X outside of string");
  492.         str->str_cur -= len;
  493.         str->str_ptr[str->str_cur] = '\0';
  494.         break;
  495.     case 'x':
  496.       grow:
  497.         while (len >= 10) {
  498.         str_ncat(str,null10,10);
  499.         len -= 10;
  500.         }
  501.         str_ncat(str,null10,len);
  502.         break;
  503.     case 'A':
  504.     case 'a':
  505.         fromstr = NEXTFROM;
  506.         aptr = str_get(fromstr);
  507.         if (pat[-1] == '*')
  508.         len = fromstr->str_cur;
  509.         if (fromstr->str_cur > len)
  510.         str_ncat(str,aptr,len);
  511.         else {
  512.         str_ncat(str,aptr,fromstr->str_cur);
  513.         len -= fromstr->str_cur;
  514.         if (datumtype == 'A') {
  515.             while (len >= 10) {
  516.             str_ncat(str,space10,10);
  517.             len -= 10;
  518.             }
  519.             str_ncat(str,space10,len);
  520.         }
  521.         else {
  522.             while (len >= 10) {
  523.             str_ncat(str,null10,10);
  524.             len -= 10;
  525.             }
  526.             str_ncat(str,null10,len);
  527.         }
  528.         }
  529.         break;
  530.     case 'B':
  531.     case 'b':
  532.         {
  533.         char *savepat = pat;
  534.         int saveitems;
  535.  
  536.  
  537.         fromstr = NEXTFROM;
  538.         saveitems = items;
  539.         aptr = str_get(fromstr);
  540.         if (pat[-1] == '*')
  541.             len = fromstr->str_cur;
  542.         pat = aptr;
  543.         aint = str->str_cur;
  544.         str->str_cur += (len+7)/8;
  545.         STR_GROW(str, str->str_cur + 1);
  546.         aptr = str->str_ptr + aint;
  547.         if (len > fromstr->str_cur)
  548.             len = fromstr->str_cur;
  549.         aint = len;
  550.         items = 0;
  551.         if (datumtype == 'B') {
  552.             for (len = 0; len++ < aint;) {
  553.             items |= *pat++ & 1;
  554.             if (len & 7)
  555.                 items <<= 1;
  556.             else {
  557.                 *aptr++ = items & 0xff;
  558.                 items = 0;
  559.             }
  560.             }
  561.         }
  562.         else {
  563.             for (len = 0; len++ < aint;) {
  564.             if (*pat++ & 1)
  565.                 items |= 128;
  566.             if (len & 7)
  567.                 items >>= 1;
  568.             else {
  569.                 *aptr++ = items & 0xff;
  570.                 items = 0;
  571.             }
  572.             }
  573.         }
  574.         if (aint & 7) {
  575.             if (datumtype == 'B')
  576.             items <<= 7 - (aint & 7);
  577.             else
  578.             items >>= 7 - (aint & 7);
  579.             *aptr++ = items & 0xff;
  580.         }
  581.         pat = str->str_ptr + str->str_cur;
  582.         while (aptr <= pat)
  583.             *aptr++ = '\0';
  584.  
  585.  
  586.         pat = savepat;
  587.         items = saveitems;
  588.         }
  589.         break;
  590.     case 'H':
  591.     case 'h':
  592.         {
  593.         char *savepat = pat;
  594.         int saveitems;
  595.  
  596.  
  597.         fromstr = NEXTFROM;
  598.         saveitems = items;
  599.         aptr = str_get(fromstr);
  600.         if (pat[-1] == '*')
  601.             len = fromstr->str_cur;
  602.         pat = aptr;
  603.         aint = str->str_cur;
  604.         str->str_cur += (len+1)/2;
  605.         STR_GROW(str, str->str_cur + 1);
  606.         aptr = str->str_ptr + aint;
  607.         if (len > fromstr->str_cur)
  608.             len = fromstr->str_cur;
  609.         aint = len;
  610.         items = 0;
  611.         if (datumtype == 'H') {
  612.             for (len = 0; len++ < aint;) {
  613.             if (isALPHA(*pat))
  614.                 items |= ((*pat++ & 15) + 9) & 15;
  615.             else
  616.                 items |= *pat++ & 15;
  617.             if (len & 1)
  618.                 items <<= 4;
  619.             else {
  620.                 *aptr++ = items & 0xff;
  621.                 items = 0;
  622.             }
  623.             }
  624.         }
  625.         else {
  626.             for (len = 0; len++ < aint;) {
  627.             if (isALPHA(*pat))
  628.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  629.             else
  630.                 items |= (*pat++ & 15) << 4;
  631.             if (len & 1)
  632.                 items >>= 4;
  633.             else {
  634.                 *aptr++ = items & 0xff;
  635.                 items = 0;
  636.             }
  637.             }
  638.         }
  639.         if (aint & 1)
  640.             *aptr++ = items & 0xff;
  641.         pat = str->str_ptr + str->str_cur;
  642.         while (aptr <= pat)
  643.             *aptr++ = '\0';
  644.  
  645.  
  646.         pat = savepat;
  647.         items = saveitems;
  648.         }
  649.         break;
  650.     case 'C':
  651.     case 'c':
  652.         while (len-- > 0) {
  653.         fromstr = NEXTFROM;
  654.         aint = (int)str_gnum(fromstr);
  655.         achar = aint;
  656.         str_ncat(str,&achar,sizeof(char));
  657.         }
  658.         break;
  659.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  660.     case 'f':
  661.     case 'F':
  662.         while (len-- > 0) {
  663.         fromstr = NEXTFROM;
  664.         afloat = (float)str_gnum(fromstr);
  665.         str_ncat(str, (char *)&afloat, sizeof (float));
  666.         }
  667.         break;
  668.     case 'd':
  669.     case 'D':
  670.         while (len-- > 0) {
  671.         fromstr = NEXTFROM;
  672.         adouble = (double)str_gnum(fromstr);
  673.         str_ncat(str, (char *)&adouble, sizeof (double));
  674.         }
  675.         break;
  676.     case 'n':
  677.         while (len-- > 0) {
  678.         fromstr = NEXTFROM;
  679.         ashort = (short)str_gnum(fromstr);
  680. #ifdef HAS_HTONS
  681.         ashort = htons(ashort);
  682. #endif
  683.         str_ncat(str,(char*)&ashort,sizeof(short));
  684.         }
  685.         break;
  686.     case 'v':
  687.         while (len-- > 0) {
  688.         fromstr = NEXTFROM;
  689.         ashort = (short)str_gnum(fromstr);
  690. #ifdef HAS_HTOVS
  691.         ashort = htovs(ashort);
  692. #endif
  693.         str_ncat(str,(char*)&ashort,sizeof(short));
  694.         }
  695.         break;
  696.     case 'S':
  697.     case 's':
  698.         while (len-- > 0) {
  699.         fromstr = NEXTFROM;
  700.         ashort = (short)str_gnum(fromstr);
  701.         str_ncat(str,(char*)&ashort,sizeof(short));
  702.         }
  703.         break;
  704.     case 'I':
  705.         while (len-- > 0) {
  706.         fromstr = NEXTFROM;
  707.         auint = U_I(str_gnum(fromstr));
  708.         str_ncat(str,(char*)&auint,sizeof(unsigned int));
  709.         }
  710.         break;
  711.     case 'i':
  712.         while (len-- > 0) {
  713.         fromstr = NEXTFROM;
  714.         aint = (int)str_gnum(fromstr);
  715.         str_ncat(str,(char*)&aint,sizeof(int));
  716.         }
  717.         break;
  718.     case 'N':
  719.         while (len-- > 0) {
  720.         fromstr = NEXTFROM;
  721.         aulong = U_L(str_gnum(fromstr));
  722. #ifdef HAS_HTONL
  723.         aulong = htonl(aulong);
  724. #endif
  725.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  726.         }
  727.         break;
  728.     case 'V':
  729.         while (len-- > 0) {
  730.         fromstr = NEXTFROM;
  731.         aulong = U_L(str_gnum(fromstr));
  732. #ifdef HAS_HTOVL
  733.         aulong = htovl(aulong);
  734. #endif
  735.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  736.         }
  737.         break;
  738.     case 'L':
  739.         while (len-- > 0) {
  740.         fromstr = NEXTFROM;
  741.         aulong = U_L(str_gnum(fromstr));
  742.         str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  743.         }
  744.         break;
  745.     case 'l':
  746.         while (len-- > 0) {
  747.         fromstr = NEXTFROM;
  748.         along = (long)str_gnum(fromstr);
  749.         str_ncat(str,(char*)&along,sizeof(long));
  750.         }
  751.         break;
  752. #ifdef QUAD
  753.     case 'Q':
  754.         while (len-- > 0) {
  755.         fromstr = NEXTFROM;
  756.         auquad = (unsigned quad)str_gnum(fromstr);
  757.         str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
  758.         }
  759.         break;
  760.     case 'q':
  761.         while (len-- > 0) {
  762.         fromstr = NEXTFROM;
  763.         aquad = (quad)str_gnum(fromstr);
  764.         str_ncat(str,(char*)&aquad,sizeof(quad));
  765.         }
  766.         break;
  767. #endif /* QUAD */
  768.     case 'p':
  769.         while (len-- > 0) {
  770.         fromstr = NEXTFROM;
  771.         aptr = str_get(fromstr);
  772.         str_ncat(str,(char*)&aptr,sizeof(char*));
  773.         }
  774.         break;
  775.     case 'u':
  776.         fromstr = NEXTFROM;
  777.         aptr = str_get(fromstr);
  778.         aint = fromstr->str_cur;
  779.         STR_GROW(str,aint * 4 / 3);
  780.         if (len <= 1)
  781.         len = 45;
  782.         else
  783.         len = len / 3 * 3;
  784.         while (aint > 0) {
  785.         int todo;
  786.  
  787.  
  788.         if (aint > len)
  789.             todo = len;
  790.         else
  791.             todo = aint;
  792.         doencodes(str, aptr, todo);
  793.         aint -= todo;
  794.         aptr += todo;
  795.         }
  796.         break;
  797.     }
  798.     }
  799.     STABSET(str);
  800. }
  801. #undef NEXTFROM
  802.  
  803.  
  804. doencodes(str, s, len)
  805. register STR *str;
  806. register char *s;
  807. register int len;
  808. {
  809.     char hunk[5];
  810.  
  811.  
  812.     *hunk = len + ' ';
  813.     str_ncat(str, hunk, 1);
  814.     hunk[4] = '\0';
  815.     while (len > 0) {
  816.     hunk[0] = ' ' + (077 & (*s >> 2));
  817.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  818.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  819.     hunk[3] = ' ' + (077 & (s[2] & 077));
  820.     str_ncat(str, hunk, 4);
  821.     s += 3;
  822.     len -= 3;
  823.     }
  824.     for (s = str->str_ptr; *s; s++) {
  825.     if (*s == ' ')
  826.         *s = '`';
  827.     }
  828.     str_ncat(str, "\n", 1);
  829. }
  830.  
  831.  
  832. void
  833. do_sprintf(str,len,sarg)
  834. register STR *str;
  835. register int len;
  836. register STR **sarg;
  837. {
  838.     register char *s;
  839.     register char *t;
  840.     register char *f;
  841.     bool dolong;
  842. #ifdef QUAD
  843.     bool doquad;
  844. #endif /* QUAD */
  845.     char ch;
  846.     static STR *sargnull = &str_no;
  847.     register char *send;
  848.     register STR *arg;
  849.     char *xs;
  850.     int xlen;
  851.     int pre;
  852.     int post;
  853.     double value;
  854.  
  855.  
  856.     str_set(str,"");
  857.     len--;            /* don't count pattern string */
  858.     t = s = str_get(*sarg);
  859.     send = s + (*sarg)->str_cur;
  860.     sarg++;
  861.     for ( ; ; len--) {
  862.  
  863.  
  864.     /*SUPPRESS 560*/
  865.     if (len <= 0 || !(arg = *sarg++))
  866.         arg = sargnull;
  867.  
  868.  
  869.     /*SUPPRESS 530*/
  870.     for ( ; t < send && *t != '%'; t++) ;
  871.     if (t >= send)
  872.         break;        /* end of format string, ignore extra args */
  873.     f = t;
  874.     *buf = '\0';
  875.     xs = buf;
  876. #ifdef QUAD
  877.     doquad =
  878. #endif /* QUAD */
  879.     dolong = FALSE;
  880.     pre = post = 0;
  881.     for (t++; t < send; t++) {
  882.         switch (*t) {
  883.         default:
  884.         ch = *(++t);
  885.         *t = '\0';
  886.         (void)sprintf(xs,f);
  887.         len++, sarg--;
  888.         xlen = strlen(xs);
  889.         break;
  890.         case '0': case '1': case '2': case '3': case '4':
  891.         case '5': case '6': case '7': case '8': case '9':
  892.         case '.': case '#': case '-': case '+': case ' ':
  893.         continue;
  894.         case 'l':
  895. #ifdef QUAD
  896.         if (dolong) {
  897.             dolong = FALSE;
  898.             doquad = TRUE;
  899.         } else
  900. #endif
  901.         dolong = TRUE;
  902.         continue;
  903.         case 'c':
  904.         ch = *(++t);
  905.         *t = '\0';
  906.         xlen = (int)str_gnum(arg);
  907.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  908.             *xs = xlen;
  909.             xs[1] = '\0';
  910.             xlen = 1;
  911.         }
  912.         else {
  913.             (void)sprintf(xs,f,xlen);
  914.             xlen = strlen(xs);
  915.         }
  916.         break;
  917.         case 'D':
  918.         dolong = TRUE;
  919.         /* FALL THROUGH */
  920.         case 'd':
  921.         ch = *(++t);
  922.         *t = '\0';
  923. #ifdef QUAD
  924.         if (doquad)
  925.             (void)sprintf(buf,s,(quad)str_gnum(arg));
  926.         else
  927. #endif
  928.         if (dolong)
  929.             (void)sprintf(xs,f,(long)str_gnum(arg));
  930.         else
  931.             (void)sprintf(xs,f,(int)str_gnum(arg));
  932.         xlen = strlen(xs);
  933.         break;
  934.         case 'X': case 'O':
  935.         dolong = TRUE;
  936.         /* FALL THROUGH */
  937.         case 'x': case 'o': case 'u':
  938.         ch = *(++t);
  939.         *t = '\0';
  940.         value = str_gnum(arg);
  941. #ifdef QUAD
  942.         if (doquad)
  943.             (void)sprintf(buf,s,(unsigned quad)value);
  944.         else
  945. #endif
  946.         if (dolong)
  947.             (void)sprintf(xs,f,U_L(value));
  948.         else
  949.             (void)sprintf(xs,f,U_I(value));
  950.         xlen = strlen(xs);
  951.         break;
  952.         case 'E': case 'e': case 'f': case 'G': case 'g':
  953.         ch = *(++t);
  954.         *t = '\0';
  955.         (void)sprintf(xs,f,str_gnum(arg));
  956.         xlen = strlen(xs);
  957.         break;
  958.         case 's':
  959.         ch = *(++t);
  960.         *t = '\0';
  961.         xs = str_get(arg);
  962.         xlen = arg->str_cur;
  963.         if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
  964.           && xlen == sizeof(STBP)) {
  965.             STR *tmpstr = Str_new(24,0);
  966.  
  967.  
  968.             stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
  969.             sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
  970.                     /* reformat to non-binary */
  971.             xs = tokenbuf;
  972.             xlen = strlen(tokenbuf);
  973.             str_free(tmpstr);
  974.         }
  975.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  976.             break;        /* so handle simple cases */
  977.         }
  978.         else if (f[1] == '-') {
  979.             char *mp = index(f, '.');
  980.             int min = atoi(f+2);
  981.  
  982.  
  983.             if (xlen < min)
  984.             post = min - xlen;
  985.             else if (mp) {
  986.             int max = atoi(mp+1);
  987.  
  988.  
  989.             if (xlen > max)
  990.                 xlen = max;
  991.             }
  992.             break;
  993.         }
  994.         else if (isDIGIT(f[1])) {
  995.             char *mp = index(f, '.');
  996.             int min = atoi(f+1);
  997.  
  998.  
  999.             if (xlen < min)
  1000.             pre = min - xlen;
  1001.             else if (mp) {
  1002.             int max = atoi(mp+1);
  1003.  
  1004.  
  1005.             if (xlen > max)
  1006.                 xlen = max;
  1007.             }
  1008.             break;
  1009.         }
  1010.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  1011.         *t = ch;
  1012.         (void)sprintf(buf,tokenbuf+64,xs);
  1013.         xs = buf;
  1014.         xlen = strlen(xs);
  1015.         break;
  1016.         }
  1017.         /* end of switch, copy results */
  1018.         *t = ch;
  1019.         STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
  1020.         str_ncat(str, s, f - s);
  1021.         if (pre) {
  1022.         repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
  1023.         str->str_cur += pre;
  1024.         }
  1025.         str_ncat(str, xs, xlen);
  1026.         if (post) {
  1027.         repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
  1028.         str->str_cur += post;
  1029.         }
  1030.         s = t;
  1031.         break;        /* break from for loop */
  1032.     }
  1033.     }
  1034.     str_ncat(str, s, t - s);
  1035.     STABSET(str);
  1036. }
  1037.  
  1038.  
  1039. STR *
  1040. do_push(ary,arglast)
  1041. register ARRAY *ary;
  1042. int *arglast;
  1043. {
  1044.     register STR **st = stack->ary_array;
  1045.     register int sp = arglast[1];
  1046.     register int items = arglast[2] - sp;
  1047.     register STR *str = &str_undef;
  1048.  
  1049.  
  1050.     for (st += ++sp; items > 0; items--,st++) {
  1051.     str = Str_new(26,0);
  1052.     if (*st)
  1053.         str_sset(str,*st);
  1054.     (void)apush(ary,str);
  1055.     }
  1056.     return str;
  1057. }
  1058.  
  1059.  
  1060. void
  1061. do_unshift(ary,arglast)
  1062. register ARRAY *ary;
  1063. int *arglast;
  1064. {
  1065.     register STR **st = stack->ary_array;
  1066.     register int sp = arglast[1];
  1067.     register int items = arglast[2] - sp;
  1068.     register STR *str;
  1069.     register int i;
  1070.  
  1071.  
  1072.     aunshift(ary,items);
  1073.     i = 0;
  1074.     for (st += ++sp; i < items; i++,st++) {
  1075.     str = Str_new(27,0);
  1076.     str_sset(str,*st);
  1077.     (void)astore(ary,i,str);
  1078.     }
  1079. }
  1080.  
  1081.  
  1082. int
  1083. do_subr(arg,gimme,arglast)
  1084. register ARG *arg;
  1085. int gimme;
  1086. int *arglast;
  1087. {
  1088.     register STR **st = stack->ary_array;
  1089.     register int sp = arglast[1];
  1090.     register int items = arglast[2] - sp;
  1091.     register SUBR *sub;
  1092.     STR *str;
  1093.     STAB *stab;
  1094.     int oldsave = savestack->ary_fill;
  1095.     int oldtmps_base = tmps_base;
  1096.     int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
  1097.     register CSV *csv;
  1098.  
  1099.  
  1100.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1101.     stab = arg[1].arg_ptr.arg_stab;
  1102.     else {
  1103.     STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1104.  
  1105.  
  1106.     if (tmpstr)
  1107.         stab = stabent(str_get(tmpstr),TRUE);
  1108.     else
  1109.         stab = Nullstab;
  1110.     }
  1111.     if (!stab)
  1112.     fatal("Undefined subroutine called");
  1113.     if (!(sub = stab_sub(stab))) {
  1114.     STR *tmpstr = arg[0].arg_ptr.arg_str;
  1115.  
  1116.  
  1117.     stab_fullname(tmpstr, stab);
  1118.     fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
  1119.     }
  1120.     if (arg->arg_type == O_DBSUBR && !sub->usersub) {
  1121.     str = stab_val(DBsub);
  1122.     saveitem(str);
  1123.     stab_fullname(str,stab);
  1124.     sub = stab_sub(DBsub);
  1125.     if (!sub)
  1126.         fatal("No DBsub routine");
  1127.     }
  1128.     str = Str_new(15, sizeof(CSV));
  1129.     str->str_state = SS_SCSV;
  1130.     (void)apush(savestack,str);
  1131.     csv = (CSV*)str->str_ptr;
  1132.     csv->sub = sub;
  1133.     csv->stab = stab;
  1134.     csv->curcsv = curcsv;
  1135.     csv->curcmd = curcmd;
  1136.     csv->depth = sub->depth;
  1137.     csv->wantarray = gimme;
  1138.     csv->hasargs = hasargs;
  1139.     curcsv = csv;
  1140.     if (sub->usersub) {
  1141.     csv->hasargs = 0;
  1142.     csv->savearray = Null(ARRAY*);;
  1143.     csv->argarray = Null(ARRAY*);
  1144.     st[sp] = arg->arg_ptr.arg_str;
  1145.     if (!hasargs)
  1146.         items = 0;
  1147.     return (*sub->usersub)(sub->userindex,sp,items);
  1148.     }
  1149.     if (hasargs) {
  1150.     csv->savearray = stab_xarray(defstab);
  1151.     csv->argarray = afake(defstab, items, &st[sp+1]);
  1152.     stab_xarray(defstab) = csv->argarray;
  1153.     }
  1154.     sub->depth++;
  1155.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  1156.     if (sub->depth == 100 && dowarn)
  1157.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  1158.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  1159.     }
  1160.     tmps_base = tmps_max;
  1161.     sp = cmd_exec(sub->cmd,gimme, --sp);    /* so do it already */
  1162.     st = stack->ary_array;
  1163.  
  1164.  
  1165.     tmps_base = oldtmps_base;
  1166.     for (items = arglast[0] + 1; items <= sp; items++)
  1167.     st[items] = str_mortal(st[items]);
  1168.         /* in case restore wipes old str */
  1169.     restorelist(oldsave);
  1170.     return sp;
  1171. }
  1172.  
  1173.  
  1174. int
  1175. do_assign(arg,gimme,arglast)
  1176. register ARG *arg;
  1177. int gimme;
  1178. int *arglast;
  1179. {
  1180.  
  1181.  
  1182.     register STR **st = stack->ary_array;
  1183.     STR **firstrelem = st + arglast[1] + 1;
  1184.     STR **firstlelem = st + arglast[0] + 1;
  1185.     STR **lastrelem = st + arglast[2];
  1186.     STR **lastlelem = st + arglast[1];
  1187.     register STR **relem;
  1188.     register STR **lelem;
  1189.  
  1190.  
  1191.     register STR *str;
  1192.     register ARRAY *ary;
  1193.     register int makelocal;
  1194.     HASH *hash;
  1195.     int i;
  1196.  
  1197.  
  1198.     makelocal = (arg->arg_flags & AF_LOCAL) != 0;
  1199.     localizing = makelocal;
  1200.     delaymagic = DM_DELAY;        /* catch simultaneous items */
  1201.  
  1202.  
  1203.     /* If there's a common identifier on both sides we have to take
  1204.      * special care that assigning the identifier on the left doesn't
  1205.      * clobber a value on the right that's used later in the list.
  1206.      */
  1207.     if (arg->arg_flags & AF_COMMON) {
  1208.     for (relem = firstrelem; relem <= lastrelem; relem++) {
  1209.         /*SUPPRESS 560*/
  1210.         if (str = *relem)
  1211.         *relem = str_mortal(str);
  1212.     }
  1213.     }
  1214.     relem = firstrelem;
  1215.     lelem = firstlelem;
  1216.     ary = Null(ARRAY*);
  1217.     hash = Null(HASH*);
  1218.     while (lelem <= lastlelem) {
  1219.     str = *lelem++;
  1220.     if (str->str_state >= SS_HASH) {
  1221.         if (str->str_state == SS_ARY) {
  1222.         if (makelocal)
  1223.             ary = saveary(str->str_u.str_stab);
  1224.         else {
  1225.             ary = stab_array(str->str_u.str_stab);
  1226.             ary->ary_fill = -1;
  1227.         }
  1228.         i = 0;
  1229.         while (relem <= lastrelem) {    /* gobble up all the rest */
  1230.             str = Str_new(28,0);
  1231.             if (*relem)
  1232.             str_sset(str,*relem);
  1233.             *(relem++) = str;
  1234.             (void)astore(ary,i++,str);
  1235.         }
  1236.         }
  1237.         else if (str->str_state == SS_HASH) {
  1238.         char *tmps;
  1239.         STR *tmpstr;
  1240.         int magic = 0;
  1241.         STAB *tmpstab = str->str_u.str_stab;
  1242.  
  1243.  
  1244.         if (makelocal)
  1245.             hash = savehash(str->str_u.str_stab);
  1246.         else {
  1247.             hash = stab_hash(str->str_u.str_stab);
  1248.             if (tmpstab == envstab) {
  1249.             magic = 'E';
  1250.             environ[0] = Nullch;
  1251.             }
  1252.             else if (tmpstab == sigstab) {
  1253.             magic = 'S';
  1254. #ifndef NSIG
  1255. #define NSIG 32
  1256. #endif
  1257.             for (i = 1; i < NSIG; i++)
  1258.                 signal(i, SIG_DFL);    /* crunch, crunch, crunch */
  1259.             }
  1260. #ifdef SOME_DBM
  1261.             else if (hash->tbl_dbm)
  1262.             magic = 'D';
  1263. #endif
  1264.             hclear(hash, magic == 'D');    /* wipe any dbm file too */
  1265.  
  1266.  
  1267.         }
  1268.         while (relem < lastrelem) {    /* gobble up all the rest */
  1269.             if (*relem)
  1270.             str = *(relem++);
  1271.             else
  1272.             str = &str_no, relem++;
  1273.             tmps = str_get(str);
  1274.             tmpstr = Str_new(29,0);
  1275.             if (*relem)
  1276.             str_sset(tmpstr,*relem);    /* value */
  1277.             *(relem++) = tmpstr;
  1278.             (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
  1279.             if (magic) {
  1280.             str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
  1281.             stabset(tmpstr->str_magic, tmpstr);
  1282.             }
  1283.         }
  1284.         }
  1285.         else
  1286.         fatal("panic: do_assign");
  1287.     }
  1288.     else {
  1289.         if (makelocal)
  1290.         saveitem(str);
  1291.         if (relem <= lastrelem) {
  1292.         str_sset(str, *relem);
  1293.         *(relem++) = str;
  1294.         }
  1295.         else {
  1296.         str_sset(str, &str_undef);
  1297.         if (gimme == G_ARRAY) {
  1298.             i = ++lastrelem - firstrelem;
  1299.             relem++;        /* tacky, I suppose */
  1300.             astore(stack,i,str);
  1301.             if (st != stack->ary_array) {
  1302.             st = stack->ary_array;
  1303.             firstrelem = st + arglast[1] + 1;
  1304.             firstlelem = st + arglast[0] + 1;
  1305.             lastlelem = st + arglast[1];
  1306.             lastrelem = st + i;
  1307.             relem = lastrelem + 1;
  1308.             }
  1309.         }
  1310.         }
  1311.         STABSET(str);
  1312.     }
  1313.     }
  1314.     if (delaymagic > 1) {
  1315.     if (delaymagic & DM_REUID) {
  1316. #ifdef HAS_SETREUID
  1317.         setreuid(uid,euid);
  1318. #else
  1319.         if (uid != euid || setuid(uid) < 0)
  1320.         fatal("No setreuid available");
  1321. #endif
  1322.     }
  1323.     if (delaymagic & DM_REGID) {
  1324. #ifdef HAS_SETREGID
  1325.         setregid(gid,egid);
  1326. #else
  1327.         if (gid != egid || setgid(gid) < 0)
  1328.         fatal("No setregid available");
  1329. #endif
  1330.     }
  1331.     }
  1332.     delaymagic = 0;
  1333.     localizing = FALSE;
  1334.     if (gimme == G_ARRAY) {
  1335.     i = lastrelem - firstrelem + 1;
  1336.     if (ary || hash)
  1337.         Copy(firstrelem, firstlelem, i, STR*);
  1338.     return arglast[0] + i;
  1339.     }
  1340.     else {
  1341.     str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
  1342.     *firstlelem = arg->arg_ptr.arg_str;
  1343.     return arglast[0] + 1;
  1344.     }
  1345. }
  1346.  
  1347.  
  1348. int                    /*SUPPRESS 590*/
  1349. do_study(str,arg,gimme,arglast)
  1350. STR *str;
  1351. ARG *arg;
  1352. int gimme;
  1353. int *arglast;
  1354. {
  1355.     register unsigned char *s;
  1356.     register int pos = str->str_cur;
  1357.     register int ch;
  1358.     register int *sfirst;
  1359.     register int *snext;
  1360.     static int maxscream = -1;
  1361.     static STR *lastscream = Nullstr;
  1362.     int retval;
  1363.     int retarg = arglast[0] + 1;
  1364.  
  1365.  
  1366. #ifndef lint
  1367.     s = (unsigned char*)(str_get(str));
  1368. #else
  1369.     s = Null(unsigned char*);
  1370. #endif
  1371.     if (lastscream)
  1372.     lastscream->str_pok &= ~SP_STUDIED;
  1373.     lastscream = str;
  1374.     if (pos <= 0) {
  1375.     retval = 0;
  1376.     goto ret;
  1377.     }
  1378.     if (pos > maxscream) {
  1379.     if (maxscream < 0) {
  1380.         maxscream = pos + 80;
  1381.         New(301,screamfirst, 256, int);
  1382.         New(302,screamnext, maxscream, int);
  1383.     }
  1384.     else {
  1385.         maxscream = pos + pos / 4;
  1386.         Renew(screamnext, maxscream, int);
  1387.     }
  1388.     }
  1389.  
  1390.  
  1391.     sfirst = screamfirst;
  1392.     snext = screamnext;
  1393.  
  1394.  
  1395.     if (!sfirst || !snext)
  1396.     fatal("do_study: out of memory");
  1397.  
  1398.  
  1399.     for (ch = 256; ch; --ch)
  1400.     *sfirst++ = -1;
  1401.     sfirst -= 256;
  1402.  
  1403.  
  1404.     while (--pos >= 0) {
  1405.     ch = s[pos];
  1406.     if (sfirst[ch] >= 0)
  1407.         snext[pos] = sfirst[ch] - pos;
  1408.     else
  1409.         snext[pos] = -pos;
  1410.     sfirst[ch] = pos;
  1411.  
  1412.  
  1413.     /* If there were any case insensitive searches, we must assume they
  1414.      * all are.  This speeds up insensitive searches much more than
  1415.      * it slows down sensitive ones.
  1416.      */
  1417.     if (sawi)
  1418.         sfirst[fold[ch]] = pos;
  1419.     }
  1420.  
  1421.  
  1422.     str->str_pok |= SP_STUDIED;
  1423.     retval = 1;
  1424.   ret:
  1425.     str_numset(arg->arg_ptr.arg_str,(double)retval);
  1426.     stack->ary_array[retarg] = arg->arg_ptr.arg_str;
  1427.     return retarg;
  1428. }
  1429.  
  1430.  
  1431. int                    /*SUPPRESS 590*/
  1432. do_defined(str,arg,gimme,arglast)
  1433. STR *str;
  1434. register ARG *arg;
  1435. int gimme;
  1436. int *arglast;
  1437. {
  1438.     register int type;
  1439.     register int retarg = arglast[0] + 1;
  1440.     int retval;
  1441.     ARRAY *ary;
  1442.     HASH *hash;
  1443.  
  1444.  
  1445.     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
  1446.     fatal("Illegal argument to defined()");
  1447.     arg = arg[1].arg_ptr.arg_arg;
  1448.     type = arg->arg_type;
  1449.  
  1450.  
  1451.     if (type == O_SUBR || type == O_DBSUBR) {
  1452.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1453.         retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
  1454.     else {
  1455.         STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1456.  
  1457.  
  1458.         retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
  1459.     }
  1460.     }
  1461.     else if (type == O_ARRAY || type == O_LARRAY ||
  1462.          type == O_ASLICE || type == O_LASLICE )
  1463.     retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
  1464.         && ary->ary_max >= 0 );
  1465.     else if (type == O_HASH || type == O_LHASH ||
  1466.          type == O_HSLICE || type == O_LHSLICE )
  1467.     retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
  1468.         && hash->tbl_array);
  1469.     else
  1470.     retval = FALSE;
  1471.     str_numset(str,(double)retval);
  1472.     stack->ary_array[retarg] = str;
  1473.     return retarg;
  1474. }
  1475.  
  1476.  
  1477. int                        /*SUPPRESS 590*/
  1478. do_undef(str,arg,gimme,arglast)
  1479. STR *str;
  1480. register ARG *arg;
  1481. int gimme;
  1482. int *arglast;
  1483. {
  1484.     register int type;
  1485.     register STAB *stab;
  1486.     int retarg = arglast[0] + 1;
  1487.  
  1488.  
  1489.     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
  1490.     fatal("Illegal argument to undef()");
  1491.     arg = arg[1].arg_ptr.arg_arg;
  1492.     type = arg->arg_type;
  1493.  
  1494.  
  1495.     if (type == O_ARRAY || type == O_LARRAY) {
  1496.     stab = arg[1].arg_ptr.arg_stab;
  1497.     afree(stab_xarray(stab));
  1498.     stab_xarray(stab) = anew(stab);        /* so "@array" still works */
  1499.     }
  1500.     else if (type == O_HASH || type == O_LHASH) {
  1501.     stab = arg[1].arg_ptr.arg_stab;
  1502.     if (stab == envstab)
  1503.         environ[0] = Nullch;
  1504.     else if (stab == sigstab) {
  1505.         int i;
  1506.  
  1507.  
  1508.         for (i = 1; i < NSIG; i++)
  1509.         signal(i, SIG_DFL);    /* munch, munch, munch */
  1510.     }
  1511.     (void)hfree(stab_xhash(stab), TRUE);
  1512.     stab_xhash(stab) = Null(HASH*);
  1513.     }
  1514.     else if (type == O_SUBR || type == O_DBSUBR) {
  1515.     stab = arg[1].arg_ptr.arg_stab;
  1516.     if ((arg[1].arg_type & A_MASK) != A_WORD) {
  1517.         STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
  1518.  
  1519.  
  1520.         if (tmpstr)
  1521.         stab = stabent(str_get(tmpstr),TRUE);
  1522.         else
  1523.         stab = Nullstab;
  1524.     }
  1525.     if (stab && stab_sub(stab)) {
  1526.         cmd_free(stab_sub(stab)->cmd);
  1527.         stab_sub(stab)->cmd = Nullcmd;
  1528.         afree(stab_sub(stab)->tosave);
  1529.         Safefree(stab_sub(stab));
  1530.         stab_sub(stab) = Null(SUBR*);
  1531.     }
  1532.     }
  1533.     else
  1534.     fatal("Can't undefine that kind of object");
  1535.     str_numset(str,0.0);
  1536.     stack->ary_array[retarg] = str;
  1537.     return retarg;
  1538. }
  1539.  
  1540.  
  1541. int
  1542. do_vec(lvalue,astr,arglast)
  1543. int lvalue;
  1544. STR *astr;
  1545. int *arglast;
  1546. {
  1547.     STR **st = stack->ary_array;
  1548.     int sp = arglast[0];
  1549.     register STR *str = st[++sp];
  1550.     register int offset = (int)str_gnum(st[++sp]);
  1551.     register int size = (int)str_gnum(st[++sp]);
  1552.     unsigned char *s = (unsigned char*)str_get(str);
  1553.     unsigned long retnum;
  1554.     int len;
  1555.  
  1556.  
  1557.     sp = arglast[1];
  1558.     offset *= size;        /* turn into bit offset */
  1559.     len = (offset + size + 7) / 8;
  1560.     if (offset < 0 || size < 1)
  1561.     retnum = 0;
  1562.     else if (!lvalue && len > str->str_cur)
  1563.     retnum = 0;
  1564.     else {
  1565.     if (len > str->str_cur) {
  1566.         STR_GROW(str,len);
  1567.         (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
  1568.         str->str_cur = len;
  1569.     }
  1570.     s = (unsigned char*)str_get(str);
  1571.     if (size < 8)
  1572.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1573.     else {
  1574.         offset >>= 3;
  1575.         if (size == 8)
  1576.         retnum = s[offset];
  1577.         else if (size == 16)
  1578.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1579.         else if (size == 32)
  1580.         retnum = ((unsigned long) s[offset] << 24) +
  1581.             ((unsigned long) s[offset + 1] << 16) +
  1582.             (s[offset + 2] << 8) + s[offset+3];
  1583.     }
  1584.  
  1585.  
  1586.     if (lvalue) {                      /* it's an lvalue! */
  1587.         struct lstring *lstr = (struct lstring*)astr;
  1588.  
  1589.  
  1590.         astr->str_magic = str;
  1591.         st[sp]->str_rare = 'v';
  1592.         lstr->lstr_offset = offset;
  1593.         lstr->lstr_len = size;
  1594.     }
  1595.     }
  1596.  
  1597.  
  1598.     str_numset(astr,(double)retnum);
  1599.     st[sp] = astr;
  1600.     return sp;
  1601. }
  1602.  
  1603.  
  1604. void
  1605. do_vecset(mstr,str)
  1606. STR *mstr;
  1607. STR *str;
  1608. {
  1609.     struct lstring *lstr = (struct lstring*)str;
  1610.     register int offset;
  1611.     register int size;
  1612.     register unsigned char *s = (unsigned char*)mstr->str_ptr;
  1613.     register unsigned long lval = U_L(str_gnum(str));
  1614.     int mask;
  1615.  
  1616.  
  1617.     mstr->str_rare = 0;
  1618.     str->str_magic = Nullstr;
  1619.     offset = lstr->lstr_offset;
  1620.     size = lstr->lstr_len;
  1621.     if (size < 8) {
  1622.     mask = (1 << size) - 1;
  1623.     size = offset & 7;
  1624.     lval &= mask;
  1625.     offset >>= 3;
  1626.     s[offset] &= ~(mask << size);
  1627.     s[offset] |= lval << size;
  1628.     }
  1629.     else {
  1630.     if (size == 8)
  1631.         s[offset] = lval & 255;
  1632.     else if (size == 16) {
  1633.         s[offset] = (lval >> 8) & 255;
  1634.         s[offset+1] = lval & 255;
  1635.     }
  1636.     else if (size == 32) {
  1637.         s[offset] = (lval >> 24) & 255;
  1638.         s[offset+1] = (lval >> 16) & 255;
  1639.         s[offset+2] = (lval >> 8) & 255;
  1640.         s[offset+3] = lval & 255;
  1641.     }
  1642.     }
  1643. }
  1644.  
  1645.  
  1646. do_chop(astr,str)
  1647. register STR *astr;
  1648. register STR *str;
  1649. {
  1650.     register char *tmps;
  1651.     register int i;
  1652.     ARRAY *ary;
  1653.     HASH *hash;
  1654.     HENT *entry;
  1655.  
  1656.  
  1657.     if (!str)
  1658.     return;
  1659.     if (str->str_state == SS_ARY) {
  1660.     ary = stab_array(str->str_u.str_stab);
  1661.     for (i = 0; i <= ary->ary_fill; i++)
  1662.         do_chop(astr,ary->ary_array[i]);
  1663.     return;
  1664.     }
  1665.     if (str->str_state == SS_HASH) {
  1666.     hash = stab_hash(str->str_u.str_stab);
  1667.     (void)hiterinit(hash);
  1668.     /*SUPPRESS 560*/
  1669.     while (entry = hiternext(hash))
  1670.         do_chop(astr,hiterval(hash,entry));
  1671.     return;
  1672.     }
  1673.     tmps = str_get(str);
  1674.     if (tmps && str->str_cur) {
  1675.     tmps += str->str_cur - 1;
  1676.     str_nset(astr,tmps,1);    /* remember last char */
  1677.     *tmps = '\0';                /* wipe it out */
  1678.     str->str_cur = tmps - str->str_ptr;
  1679.     str->str_nok = 0;
  1680.     STABSET(str);
  1681.     }
  1682.     else
  1683.     str_nset(astr,"",0);
  1684. }
  1685.  
  1686.  
  1687. do_vop(optype,str,left,right)
  1688. STR *str;
  1689. STR *left;
  1690. STR *right;
  1691. {
  1692.     register char *s;
  1693.     register char *l = str_get(left);
  1694.     register char *r = str_get(right);
  1695.     register int len;
  1696.  
  1697.  
  1698.     len = left->str_cur;
  1699.     if (len > right->str_cur)
  1700.     len = right->str_cur;
  1701.     if (str->str_cur > len)
  1702.     str->str_cur = len;
  1703.     else if (str->str_cur < len) {
  1704.     STR_GROW(str,len);
  1705.     (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
  1706.     str->str_cur = len;
  1707.     }
  1708.     str->str_pok = 1;
  1709.     str->str_nok = 0;
  1710.     s = str->str_ptr;
  1711.     if (!s) {
  1712.     str_nset(str,"",0);
  1713.     s = str->str_ptr;
  1714.     }
  1715.     switch (optype) {
  1716.     case O_BIT_AND:
  1717.     while (len--)
  1718.         *s++ = *l++ & *r++;
  1719.     break;
  1720.     case O_XOR:
  1721.     while (len--)
  1722.         *s++ = *l++ ^ *r++;
  1723.     goto mop_up;
  1724.     case O_BIT_OR:
  1725.     while (len--)
  1726.         *s++ = *l++ | *r++;
  1727.       mop_up:
  1728.     len = str->str_cur;
  1729.     if (right->str_cur > len)
  1730.         str_ncat(str,right->str_ptr+len,right->str_cur - len);
  1731.     else if (left->str_cur > len)
  1732.         str_ncat(str,left->str_ptr+len,left->str_cur - len);
  1733.     break;
  1734.     }
  1735. }
  1736.  
  1737.  
  1738. int
  1739. do_syscall(arglast)
  1740. int *arglast;
  1741. {
  1742.     register STR **st = stack->ary_array;
  1743.     register int sp = arglast[1];
  1744.     register int items = arglast[2] - sp;
  1745.     unsigned long arg[8];
  1746.     register int i = 0;
  1747.     int retval = -1;
  1748.  
  1749.  
  1750. #ifdef HAS_SYSCALL
  1751. #ifdef TAINT
  1752.     for (st += ++sp; items--; st++)
  1753.     tainted |= (*st)->str_tainted;
  1754.     st = stack->ary_array;
  1755.     sp = arglast[1];
  1756.     items = arglast[2] - sp;
  1757. #endif
  1758. #ifdef TAINT
  1759.     taintproper("Insecure dependency in syscall");
  1760. #endif
  1761.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  1762.      * or where sizeof(long) != sizeof(char*).  But such machines will
  1763.      * not likely have syscall implemented either, so who cares?
  1764.      */
  1765.     while (items--) {
  1766.     if (st[++sp]->str_nok || !i)
  1767.         arg[i++] = (unsigned long)str_gnum(st[sp]);
  1768. #ifndef lint
  1769.     else
  1770.         arg[i++] = (unsigned long)st[sp]->str_ptr;
  1771. #endif /* lint */
  1772.     }
  1773.     sp = arglast[1];
  1774.     items = arglast[2] - sp;
  1775.     switch (items) {
  1776.     case 0:
  1777.     fatal("Too few args to syscall");
  1778.     case 1:
  1779.     retval = syscall(arg[0]);
  1780.     break;
  1781.     case 2:
  1782.     retval = syscall(arg[0],arg[1]);
  1783.     break;
  1784.     case 3:
  1785.     retval = syscall(arg[0],arg[1],arg[2]);
  1786.     break;
  1787.     case 4:
  1788.     retval = syscall(arg[0],arg[1],arg[2],arg[3]);
  1789.     break;
  1790.     case 5:
  1791.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
  1792.     break;
  1793.     case 6:
  1794.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
  1795.     break;
  1796.     case 7:
  1797.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
  1798.     break;
  1799.     case 8:
  1800.     retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
  1801.       arg[7]);
  1802.     break;
  1803.     }
  1804.     return retval;
  1805. #else
  1806.     fatal("syscall() unimplemented");
  1807. #endif
  1808. }
  1809.  
  1810.  
  1811.  
  1812.  
  1813.